home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln1085.arc / GSXGDP.INC < prev    next >
Text File  |  1986-02-27  |  5KB  |  118 lines
  1. { ---  GDP procedures.  INCLUDE WITH GSX IF ANY REQUIRED  --- }
  2. {*********************************************************}
  3. procedure bar( xll, yll, xur, yur : integer);
  4.    {in: arguments correspond to lower left and upper right
  5.     (x,y) coordinates of the rectangular bar in NDC units }
  6. {*********************************************************}
  7.   var    contrl : array[1..6] of integer;   {Some GDP
  8.                           functions use a 6th element
  9.                           of the contrl array as a secondary
  10.                           identifier.  Here bar = 1 }
  11.          ptsin : array[1..4] of integer;
  12.          intin, intout, ptsout : integer;
  13.  
  14.   begin      contrl[1] :=   11;
  15.              contrl[2] :=    2;
  16.              contrl[4] :=    0;
  17.              contrl[6] :=    1;   {specifies bar}
  18.              ptsin[1]  :=  xll;
  19.              ptsin[2]  :=  yll;
  20.              ptsin[3]  :=  xur;
  21.              ptsin[4]  :=  yur;
  22.              setpblock( addr(contrl), addr(intin ),
  23.                         addr( ptsin), addr(intout),
  24.                         addr(ptsout));
  25.              callgdos( addr(pb))
  26.   end;
  27.  
  28. {************************************************************************}
  29. procedure arc( radius, xcenter, ycenter, starta, enda : integer);
  30.   {in: center, radius, starting and ending angle to determine arc}
  31. {************************************************************************}
  32.    {not currently supported on Rainbow displays, LA50, or LP100}
  33.    {assumes total arc lies within NDC coordinate boundaries}
  34.   const     pi     =  3.141592 ;
  35.   var       contrl : array[1..6] of integer;
  36.             intin  : array[1..2] of integer;
  37.             ptsin  : array[1..8] of integer;
  38.             intout, ptsout : integer;
  39.  
  40.   begin     contrl[1] :=  11;
  41.             contrl[2] :=   4;
  42.             contrl[4] :=   2;
  43.             contrl[6] :=   2;
  44.             intin[1]  := starta;
  45.             intin[2]  := enda;
  46.             ptsin[1]  := xcenter;
  47.             ptsin[2]  := ycenter;
  48.             ptsin[3]  := round(radius * cos(pi * starta / 1800)) + xcenter;
  49.             ptsin[4]  := round(radius * sin(pi * starta / 1800)) + ycenter;
  50.             ptsin[5]  := round(radius * cos(pi * enda / 1800)) + xcenter;
  51.             ptsin[6]  := round(radius * sin(pi * enda / 1800)) + ycenter;
  52.             ptsin[7]  := radius;
  53.             ptsin[8]  :=  0;
  54.             setpblock( addr(contrl), addr( intin),
  55.                        addr(ptsin ), addr(intout),
  56.                        addr(ptsout));
  57.             callgdos( addr(pb))
  58.   end;
  59.  
  60. {**********************************************************************}
  61. procedure pie( xcenter, ycenter,  x1,y1,   x2,y2 : integer);
  62.   {in: center coordinates and two points on the circle.}
  63. {**********************************************************************}
  64.    {Procedure draws and fills pie using current fill attributes}
  65.    {Assume total pie lies within NDC boundaries}
  66.   var        contrl : array[1..6] of integer;
  67.              intin  : array[1..2] of integer;
  68.              ptsin  : array[1..8] of integer;
  69.              intout, ptsout : integer;
  70.                  i  : integer;
  71.  
  72.   begin        contrl[1] :=  11;
  73.                contrl[2] :=   4;
  74.                contrl[4] :=   2;
  75.                contrl[6] :=   3;
  76.                for i := 1 to 2 do intin[i] := 0;
  77.                ptsin[1]  := xcenter;
  78.                ptsin[2]  := ycenter;
  79.                ptsin[3]  := x1;
  80.                ptsin[4]  := y1;
  81.                ptsin[5]  := x2;
  82.                ptsin[6]  := y2;
  83.                ptsin[7]  := round( sqrt( sqr(x1-x2) + sqr(y1-y2)));
  84.                ptsin[8]  :=  0;
  85.                setpblock( addr(contrl), addr( intin),
  86.                           addr(ptsin ), addr(intout),
  87.                           addr(ptsout));
  88.                callgdos( addr(pb))
  89.    end;
  90.  
  91. {*************************************************************************}
  92. procedure circle( xcenter, ycenter, radius : integer);
  93.   {in: center coordinates and radius}
  94. {*************************************************************************}
  95.   {Procedure draws and fills the circle using current fill attributes}
  96.   {Assumes total circle lies within NDC boundaries, thus no clipping occurs.
  97.   Some interesting wraparound fills occur of any points lie outside
  98.   these boundaries.}
  99.   var       contrl, ptsin : array[1..6] of integer;
  100.              intin, intout, ptsout : integer;
  101.  
  102.   begin     contrl[1] := 11;
  103.             contrl[2] :=  3;
  104.             contrl[4] :=  0;
  105.             contrl[6] :=  4;
  106.              ptsin[1] := xcenter;
  107.              ptsin[2] := ycenter;
  108.              ptsin[3] := xcenter + radius;   {circumference points within}
  109.              ptsin[4] := ycenter;            {     NDC boundaries        }
  110.              ptsin[5] := radius;
  111.              ptsin[6] :=  0;
  112.              setpblock( addr(contrl), addr( intin),
  113.                         addr(ptsin ), addr(intout),
  114.                         addr(ptsout));
  115.              callgdos( addr(pb))
  116.   end;
  117.  
  118.